perm filename MFOUT.DIF[MF,DEK] blob
sn#557219 filedate 1981-01-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 1,1
C00009 00003 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 6,6
C00012 00004 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 7,7
C00015 00005 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 7,7
C00018 00006 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 8,8
C00021 00007
C00024 00008 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
C00027 00009 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
C00030 00010 1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
C00033 ENDMK
C⊗;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 1,1
**** File 1) MFOUT.SAI[MF,DEK]/1P/1L
1) COMMENT ⊗ VALID 00012 PAGES
1) C REC PAGE DESCRIPTION
**** File 2) MFOUT.SAI[MF,DRF]/1P/1L
2) COMMENT ⊗ VALID 00013 PAGES
2) C REC PAGE DESCRIPTION
***************
**** File 1) MFOUT.SAI[MF,DEK]/1P/7L
1) C00024 00005 comment special stuff for byte-oriented output
1) C00028 00006 Routines for proof mode.
1) C00048 00007 Routines for chr mode.
1) C00053 00008 Routines for fnt mode.
1) C00059 00009 Routines for .oc files and .wd files
1) C00060 00010 Routines for tfm mode.
1) C00073 00011 Routines for Alphatype fonts
1) C00077 00012 internal procedure initout # get MFOUT started properly
1) C00084 ENDMK
1) C⊗;
**** File 2) MFOUT.SAI[MF,DRF]/1P/7L
2) C00024 00005 special stuff for byte-oriented output
2) C00028 00006 Routines for proof mode.
2) C00048 00007 Routines for chr mode.
2) C00054 00008 Routines for fnt mode.
2) C00060 00009 Routines for .oc files and .wd files
2) C00061 00010 Routines for tfm mode.
2) C00074 00011 Routines for Alphatype fonts
2) C00078 00012 internal procedure initout # get MFOUT started properly
2) C00085 00013 Stuff for extended memory
2) C00091 ENDMK
2) C⊗;
***************
**** File 1) MFOUT.SAI[MF,DEK]/3P/77L
1) IFTENEX
1) string procedure daytime # translate octaltime into a string;
**** File 2) MFOUT.SAI[MF,DRF]/3P/77L
2) IFC TENEX OR TOPS20 THENC
2) string procedure daytime # translate octaltime into a string;
***************
**** File 1) MFOUT.SAI[MF,DEK]/3P/96L
1) ENDTENEX
1) comment openofil;
**** File 2) MFOUT.SAI[MF,DRF]/3P/96L
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 3,3
2) ENDC
2) comment openofil;
***************
**** File 1) MFOUT.SAI[MF,DEK]/5P/1L
1) comment special stuff for byte-oriented output;
1) ifc PRESS or DOVERMODES thenc
**** File 2) MFOUT.SAI[MF,DRF]/5P/1L
2) comment special stuff for byte-oriented output;
2) ifc PRESS or DOVERMODES thenc
***************
**** File 1) MFOUT.SAI[MF,DEK]/5P/64L
1) rembytes←numbytes mod 4;
1) arryout(ochan[mode],memory[ptr],numwords);
1) nextword[mode]←memory[ptr+numwords] land (-1 lsh (bitsperwd-8*rembytes));
1) bytecount[mode]←bytecount[mode]+numbytes;
**** File 2) MFOUT.SAI[MF,DRF]/5P/64L
2) arryout(ochan[mode],memory[ptr],numwords);
2) nextword[mode]←memory[ptr+numwords];
2) bytecount[mode]←bytecount[mode]+numbytes;
***************
**** File 1) MFOUT.SAI[MF,DEK]/6P/261L
1) xw←x*rspan+y; z←rast[xw];
1) k←bitsperwd; if z then
1) begin zl←z lsh -1; zr← z lsh 1;
1) if x≠xleft then zl←(rast[xw-rspan] lsh(bitsperwd-1))lor zl;
1) if x≠xright then zr←(rast[xw+rspan] lsh(1-bitsperwd))lor zr;
1) if y≠yhigh then zt←rast[xw+1] else zt←0;
1) if y≠ylow then zb←rast[xw-1] else zb←0;
1) if z=-1 and zt=-1 and zr=-1 and zb=-1 and zl=-1 then
**** File 2) MFOUT.SAI[MF,DRF]/6P/261L
2) xw←x*rspan+y; var!gets!rast(z,xw) # z←rast[xw];
2) k←bitsperwd; if z then
2) begin zl←z lsh -1; zr← z lsh 1;
2) if x≠xleft then var!gets!rast!lsh!expr!lor!var
2) (zl,xw-rspan,bitsperwd-1);
2) # zl←(rast[xw-rspan] lsh(bitsperwd-1))lor zl;
2) if x≠xright then var!gets!rast!lsh!expr!lor!var
2) (zr,xw+rspan,1-bitsperwd);
2) # zr←(rast[xw+rspan] lsh(1-bitsperwd))lor zr;
2) if y≠yhigh then
2) var!gets!rast(zt,xw+1) comment zt←rast[xw+1];
2) else zt←0;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 6,6
2) if y≠ylow then
2) var!gets!rast(zb,xw-1) comment zb←rast[xw-1];
2) else zb←0;
2) if z=-1 and zt=-1 and zr=-1 and zb=-1 and zl=-1 then
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/1L
1) comment Routines for chr mode.
**** File 2) MFOUT.SAI[MF,DRF]/6P/319L
2) IFDVI
2) procedure makeproof; begin
2) print("No DVI proof mode yet.",nextline);
2) end;
2) ENDDVI
2) comment Routines for chr mode.
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/20L
1) for y←xw+ylow thru xw+yhigh do if rast[y] then go to nonblank1;
1) xl←xl+1;
**** File 2) MFOUT.SAI[MF,DRF]/7P/20L
2) for y←xw+ylow thru xw+yhigh do
2) IFXMEM begin var!gets!rast(xtemp,y); if xtemp then go to nonblank1; end;
2) ELSEC if rast[y] then go to nonblank1;
2) ENDC
2) xl←xl+1;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/26L
1) for y←xw+ylow thru xw+yhigh do if rast[y] then go to nonblank2;
1) xr←xr-1;
**** File 2) MFOUT.SAI[MF,DRF]/7P/29L
2) for y←xw+ylow thru xw+yhigh do
2) IFXMEM begin var!gets!rast(xtemp,y); if xtemp then go to nonblank2; end;
2) ELSEC if rast[y] then go to nonblank2;
2) ENDC
2) xr←xr-1;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/33L
1) if rast[xw] then go to nonblank3;
1) yl←yl+1;
**** File 2) MFOUT.SAI[MF,DRF]/7P/39L
2) IFXMEM begin var!gets!rast(xtemp,xw); if xtemp then go to nonblank3; end;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 7,7
2) ELSEC if rast[xw] then go to nonblank3;
2) ENDC
2) yl←yl+1;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/39L
1) if rast[xw] then go to nonblank4;
1) yh←yh-1;
**** File 2) MFOUT.SAI[MF,DRF]/7P/47L
2) IFXMEM begin var!gets!rast(xtemp,xw); if xtemp then go to nonblank4; end;
2) ELSEC if rast[xw] then go to nonblank4;
2) ENDC
2) yh←yh-1;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/43L
1) for y←xw+ylow thru xw+yhigh do z←z lor rast[y];
1) lz←0; while z>0 do
**** File 2) MFOUT.SAI[MF,DRF]/7P/53L
2) for y←xw+ylow thru xw+yhigh do var!gets!rast!lor!var(z,y) # z←z lor rast[y];
2) lz←0; while z>0 do
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/55L
1) x←xlb; z←rast[xw] lsh lz; bits←bitsperwd-lz;
1) loop begin if bits=0 then
1) begin bits←bitsperwd; xw←xw+rspan; z←rast[xw];
1) end;
**** File 2) MFOUT.SAI[MF,DRF]/7P/65L
2) x←xlb; var!gets!rast!lsh!expr(z,xw,lz) # z←rast[xw] lsh lz;
2) bits←bitsperwd-lz;
2) loop begin if bits=0 then
2) begin bits←bitsperwd; xw←xw+rspan;
2) var!gets!rast(z,xw) # z←rast[xw];
2) end;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/70L
1) if rast[xx] then go to nonblank;
1) go to rowdone;
**** File 2) MFOUT.SAI[MF,DRF]/7P/82L
2) IFXMEM begin var!gets!rast(xtemp,xx);
2) if xtemp then go to nonblank; end;
2) ELSEC if rast[xx] then go to nonblank;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 7,7
2) ENDC
2) go to rowdone;
***************
**** File 1) MFOUT.SAI[MF,DEK]/7P/78L
1) if rast[xx] then go to nonblank;
1) go to rowdone;
**** File 2) MFOUT.SAI[MF,DRF]/7P/93L
2) IFXMEM begin var!gets!rast(xtemp,xx);
2) if xtemp then go to nonblank; end;
2) ELSEC if rast[xx] then go to nonblank;
2) ENDC
2) go to rowdone;
***************
**** File 1) MFOUT.SAI[MF,DEK]/8P/20L
1) for y←xw+ylow thru xw+yhigh do z←z lor rast[y];
1) if z then done;
**** File 2) MFOUT.SAI[MF,DRF]/8P/20L
2) for y←xw+ylow thru xw+yhigh do
2) var!gets!rast!lor!var(z,y) # z←z lor rast[y];
2) if z then done;
***************
**** File 1) MFOUT.SAI[MF,DEK]/8P/37L
1) for y←xw+ylow thru xw+yhigh do z←z lor rast[y];
1) if z then done;
**** File 2) MFOUT.SAI[MF,DRF]/8P/38L
2) for y←xw+ylow thru xw+yhigh do
2) var!gets!rast!lor!var(z,y) # z←z lor rast[y];
2) if z then done;
***************
**** File 1) MFOUT.SAI[MF,DEK]/8P/47L
1) if rast[xw] then go to nonblank3;
1) yl←yl+1;
**** File 2) MFOUT.SAI[MF,DRF]/8P/49L
2) IFXMEM begin var!gets!rast(xtemp,xw); if xtemp then go to nonblank3; end;
2) ELSEC if rast[xw] then go to nonblank3;
2) ENDC
2) yl←yl+1;
***************
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 8,8
**** File 1) MFOUT.SAI[MF,DEK]/8P/53L
1) if rast[xw] then go to nonblank4;
1) yh←yh-1;
**** File 2) MFOUT.SAI[MF,DRF]/8P/57L
2) IFXMEM begin var!gets!rast(xtemp,xw); if xtemp then go to nonblank4; end;
2) ELSEC if rast[xw] then go to nonblank4;
2) ENDC
2) yh←yh-1;
***************
**** File 1) MFOUT.SAI[MF,DEK]/8P/88L
1) begin z←(rast[y] lsh lz)+(rast[y+rspan] lsh lz1);
1) accum ← accum lor (z lsh (-bits));
**** File 2) MFOUT.SAI[MF,DRF]/8P/94L
2) begin var!gets!two!rast!cols(z,y,lz)
2) # z←(rast[y] lsh lz)+(rast[y+rspan] lsh lz1);
2) accum ← accum lor (z lsh (-bits));
***************
**** File 1) MFOUT.SAI[MF,DEK]/8P/99L
1) for y←yh step -1 until yl do for xw←y+xlw step rspan until y+xrw do
1) wordout(ch,(rast[xw]lsh lz)+(rast[xw+rspan]lsh lz1));
1) end;
**** File 2) MFOUT.SAI[MF,DRF]/8P/106L
2) for y←yh step -1 until yl do for xw←y+xlw step rspan until y+xrw do
2) IFXMEM begin var!gets!two!rast!cols(xtemp,xw,lz);
2) wordout(ch,xtemp); end;
2) ELSEC wordout(ch,(rast[xw]lsh lz)+(rast[xw+rspan]lsh lz1));
2) ENDC
2) end;
***************
**** File 1) MFOUT.SAI[MF,DEK]/11P/9L
1) ifc WAITS thenc
1) ifc SPECRAST thenc
1) require "alfbig.rel[alf,dek]" load_module; elsec
1) require "alfnrm.rel[alf,dek]" load_module; endc
1) elsec
1) internal procedure clean;; internal procedure boundarize;;
1) internal procedure crscode;;
1) endc
1) procedure alfout # outputs portion of character in crsmode;
**** File 2) MFOUT.SAI[MF,DRF]/11P/9L
2) IFC ALPHATYPEMODE THENC
2) require "ALFOUT.REL" load_module; comment clean, boundarize, crscode;
2) ELSEC
2) internal procedure clean;; internal procedure boundarize;;
2) internal procedure crscode;;
2) ENDC
2) procedure alfout # outputs portion of character in crsmode;
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/12L
1) IFTENEX octaltime←gtad; ENDTENEX
1) IFWAITS octaltime←call(0,"ACCTIM"); ENDWAITS
**** File 2) MFOUT.SAI[MF,DRF]/12P/12L
2) IFC TENEX OR TOPS20 THENC octaltime←gtad; ENDC
2) IFWAITS octaltime←call(0,"ACCTIM"); ENDWAITS
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/25L
1) ENDTENEX
1) IFWAITS
1) dlbufptr←location(dlbuf[0]);
**** File 2) MFOUT.SAI[MF,DRF]/12P/25L
2) ELSEC
2) dlbufptr←location(dlbuf[0]);
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/30L
1) ENDWAITS
1) ENDPRESS
**** File 2) MFOUT.SAI[MF,DRF]/12P/29L
2) ENDC
2) ENDPRESS
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/71L
1) IFTENEX
1) procedure binaryrelease(integer chan);
**** File 2) MFOUT.SAI[MF,DRF]/12P/70L
2) IFC TOPS20 OR TENEX THENC
2) procedure binaryrelease(integer chan);
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/85L
1) ENDTENEX
1) IFWAITS
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
**** File 2) MFOUT.SAI[MF,DRF]/12P/84L
2) ENDC
2) IFWAITS
***************
**** File 1) MFOUT.SAI[MF,DEK]/12P/135L
1) IFWAITS ptostr(0,
1) IFXGP "r xgpsyn;"&flname[proof]&"/L" ENDXGP
1) IFPRESS "dover "&flname[proof] ENDPRESS
1) );
1) ENDWAITS
1) end;
1) end;
1) end
**** File 2) MFOUT.SAI[MF,DRF]/12P/134L
2) ifc WAITS and XGP thenc
2) ptostr(0,"r xgpsyn;"&flname[proof]&"/L"); endc
2) end;
2) end;
2) comment Stuff for extended memory;
2) IFXMEM
2) define bigsmap=false; comment only true when DEC fixes process smaping;
2) internal integer indir # addressing '@INDIR' gets the raster item whose
2) number is in register '15;
2) internal integer xtemp # used with VAR!GETS!RAST when there's no place
2) else to put it;
2) internal integer xblte # extended-blt instruction;
2) define fhslf='400000, pmrd='100000, pmwr='40000, pmcnt='400000,
2) smap='767, pmap='56, rpcap='150, epcap='151;
2) procedure makesect(integer s); begin
2) start!code
2) movei 1,0;
2) movsi 2,fhslf;
2) add 2,s; comment make new section;
2) movsi 3,pmrd+pmwr+pmcnt;
2) hrri 3,1; comment number of sections to be made;
2) jsys smap;
2) end;
2) end;
2) procedure delsect(integer s); begin
2) start!code
2) movni 1,1;
2) movsi 2,fhslf;
2) add 2,s; comment delete section;
2) movsi 3,pmrd+pmwr+pmcnt;
2) hrri 3,1; comment number of sections to be deleted;
2) jsys smap;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
2) end;
2) end;
2) procedure makesectone; begin
2) if bigsmap then begin
2) start!code comment smap section 0 to section 1;
2) movsi 1,fhslf;
2) move 2,1;
2) hrri 2,1; comment make section 1;
2) movsi 3,pmrd+pmwr;
2) hrri 3,1; comment one section to be mapped;
2) jsys smap;
2) end;
2) end
2) else begin comment only smap with 0 in acc 1, never fhslf;
2) makesect(1);
2) start!code comment pmap pages 0-777 to 1000-1777;
2) movsi 1,fhslf;
2) move 2,1;
2) hrri 2,'1000;
2) movsi 3,pmrd+pmwr+pmcnt;
2) hrri 3,'1000;
2) jsys pmap;
2) end
2) end
2) end;
2) procedure delsectone; begin
2) if bigsmap then delsect(1)
2) else begin
2) start!code comment unmap pages 1000-1777;
2) movni 1,1;
2) movsi 2,fhslf;
2) hrri 2,'1000;
2) movsi 3,pmcnt;
2) hrri 3,'1000;
2) jsys pmap;
2) end;
2) delsect(1);
2) end
2) end;
2) integer numsections # number of 256Kword sections to use for raster;
2) forward simple procedure cntrlc # the control-c handler;
2) integer array cntrlcmess[0:30] # can't use strings during interrupts;
2) integer array continuemess[0:30] # can't use strings during interrupts;
2) internal procedure initxmem; begin integer i; string s;
2) start!code comment test for recently fixed sail bug;
2) movei 1,2;
2) move 2,access(1); comment specifically, this move should not
2) compile into MOVE 2,1;
1) MFOUT.SAI[MF,DEK] and 2) MFOUT.SAI[MF,DRF] 1-22-81 11:14 pages 12,12
2) movem 2,xtemp;
2) end;
2) if xtemp neq 1 then
2) errorstop("Your SAIL compiler isn't up to date enough.");
2)
2) start!code comment Enable control-c interrupt handler;
2) movei 1,fhslf;
2) jsys rpcap;
2) movsi 7,'400000;
2) ior 3,7;
2) jsys epcap;
2) end;
2) psimap(1,cntrlc,0,1); enable(1); ati(1,3);
2) s←"
2) You are control-c'ing out of Metafont. Do you want to be able to continue? ";
2) i←-1;while s do begin cntrlcmess[i←i+1]←cvasc(s); s←s[6 to inf]; end;
2) s←"Metafont continuing... ";
2) i←-1;while s do begin continuemess[i←i+1]←cvasc(s); s←s[6 to inf]; end;
2) xblte←'020000000000;
2) indir←('150002 lsh 18) - rast0 # so @INDIR addresses RAST[R'15];
2) numsections←((rast1-rast0) lsh -18) + 1;
2) makesectone;
2) for i←2 step 1 until numsections+1 do makesect(i);
2) end;
2) internal procedure closexmem; begin integer i;
2) delsectone;
2) for i←2 step 1 until numsections+1 do delsect(i);
2) end;
2) simple procedure cntrlc; begin integer answer;
2) start!code movei 1,cntrlcmess[0]; psout; pbin; movem 1,answer; end;
2) if answer="y" or answer="Y" then begin
2) quick!code haltf end;
2) start!code movei 1,continuemess[0]; psout; end;
2) end
2) else begin integer i; label foo;
2) delsectone; for i←2 step 1 until numsections+1 do delsect(i);
2) foo: quick!code haltf end;
2) print("Can't continue this Metafont anymore."); go to foo; end;
2) end;
2)
2) ENDXMEM
2) end
***************